home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / GFXFX2.ZIP / PV.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-14  |  14.2 KB  |  434 lines
  1.  
  2. (*
  3. ** Picture Viewer supports the following formats:
  4. **
  5. **   GIF - Compuserve <tm> Graphics Interchange Format,
  6. **   PCX - Zsoft, (including fast-load and save procedures)
  7. **   CEL - Autodesk Annimator brush,
  8. **   RIX - ColorRIX/EGA Paint (SC?),
  9. **
  10. ** and limited
  11. **   BMP - Windows <tm> and OS/2 <tm> Device-Independant Bitmap,
  12. **   IFF/ILBM - Electronic Arts <tm> Deluxe Paint InterLeaved BitMap
  13. **
  14. ** Press M to force another graphics-mode
  15. **
  16. ** This picture-viewer makes use of a general BGI-driver of Borland <tm>
  17. **
  18. ** Made by Bas van Gaalen
  19. *)
  20.  
  21. {$v-}
  22.  
  23. program pictureview; { PV.PAS }
  24. { Picture viewer }
  25. uses
  26.   dos,u_vga,u_txt,u_misc,u_kb,
  27.   u_ffgif,u_ffpcx,u_ffcel,u_ffrix,u_ffbmp,u_fflbm;
  28.  
  29. {--------------------------------------------- file select consts/types/vars }
  30.  
  31. const
  32.   itemsize=58;
  33.   mode:shortint=-1;
  34.   shadow:byte=darkgray;
  35.   w_title:byte=_lightgray+lightblue;
  36.   w_attr:byte=_lightgray+darkgray;
  37.   w_select:byte=_blue+lightgray;
  38.   w_scrbar:byte=_lightgray+lightblue;
  39.   w_norm:byte=_lightgray+blue;
  40.  
  41. type
  42.   str3=string[3];
  43.   str20=string[20];
  44.   str25=string[25];
  45.   str80=string[80];
  46.   item=string[itemsize];
  47.   selectptr=^selectrec;
  48.   selectrec=array[0..65000 div sizeof(item)] of item;
  49.  
  50. var
  51.   list:selectptr;
  52.   prevpath,globalpath:pathstr;
  53.   curnum,files,listsize:word;
  54.   scrsize,drives:byte;
  55.  
  56. {----------------------------------------------------------------------------}
  57.  
  58. procedure setmode;
  59. const
  60.   modes:array[0..7] of string[10]=(
  61.     '320x200','640x350','640x400','640x480',
  62.     '800x600','1024x768','1280x1024','autodetect');
  63. var key:word; i:byte;
  64. begin
  65.   setscr; nwindow(60,5,74,14,' select mode ',pos_hi+pos_mi,w_title,w_attr,shadow);
  66.   for i:=0 to 7 do dspat(chr(ord('0')+i)+'. '+modes[i],61,6+i,w_norm);
  67.   key:=getekey;
  68.   case key of
  69.     crsr0:mode:=0;
  70.     crsr1:mode:=5;
  71.     crsr2:mode:=1;
  72.     crsr3:mode:=2;
  73.     crsr4:mode:=3;
  74.     crsr5:mode:=4;
  75.     crsr6:mode:=6;
  76.     crsr7:mode:=-1;
  77.   end;
  78.   getscr;
  79. end;
  80.  
  81. {--------------------------------------------------- file select procs/funcs }
  82.  
  83. function select(x,y,xe,ye:byte; path,title:str80; cur,max:word; listptr:selectptr):word;
  84. var startpos,basepos:longint; prescr,scrpos,winsize:byte; esc:boolean;
  85.  
  86. procedure putline(abswinpos:byte; absbasepos:word); begin
  87.   dsptxt(copy(listptr^[absbasepos],1,xe-x-1),x+1,y+abswinpos); end;
  88.  
  89. procedure dumpscreen(start:word);
  90. var i,last:byte;
  91. begin
  92.   if max<winsize then last:=max else last:=winsize;
  93.   for i:=1 to last do putline(i,start+i-1);
  94. end;
  95.  
  96. begin
  97.   if listptr=nil then exit;
  98.   setscr; nwindow(x,y-2,xe,ye,title,pos_hi+pos_mi,w_title,w_attr,shadow);
  99.   fillattr(x+1,y+1,xe-1,ye-1,w_norm);
  100.   filltext(#196,x+1,y,xe-1,y,w_attr);
  101.   dspat(copy(path,1,xe-x-1),x+1,y-1,w_norm);
  102.   winsize:=ye-y-1; basepos:=cur;
  103.   if cur<(winsize div 2) then startpos:=0
  104.   else if cur>=max-(winsize div 2) then startpos:=max-winsize
  105.   else startpos:=basepos-(winsize div 2);
  106.   dumpscreen(startpos);
  107.   scrpos:=cur-startpos; prescr:=succ(scrpos);
  108.   esc:=false;
  109.   repeat
  110.     if prescr<>scrpos then begin
  111.       fillattr(x+1,y+prescr,xe-1,y+prescr,w_norm);
  112.       fillattr(x+1,y+scrpos,xe-1,y+scrpos,w_select);
  113.       prescr:=scrpos;
  114.     end;
  115.     scrollbar(xe,y-1,basepos,winsize+2,max,w_scrbar);
  116.     case getekey of
  117.       crsrleft,
  118.       crsrup:if basepos>1 then begin
  119.         prescr:=scrpos;
  120.         dec(basepos);
  121.         if scrpos>1 then dec(scrpos)
  122.         else begin
  123.           scrolltexty('d',x+1,y+1,xe-1,y+winsize);
  124.           putline(scrpos,basepos-1);
  125.         end;
  126.       end;
  127.       crsrright,
  128.       crsrdown:if basepos<max then begin
  129.         prescr:=scrpos;
  130.         inc(basepos);
  131.         if scrpos<winsize then inc(scrpos)
  132.         else begin
  133.           scrolltexty('u',x+1,y+1,xe-1,y+winsize);
  134.           putline(scrpos,basepos-1);
  135.         end;
  136.       end;
  137.       crsrhome:if basepos<>1 then begin
  138.         prescr:=scrpos;
  139.         scrpos:=1;
  140.         basepos:=1;
  141.         dumpscreen(0);
  142.       end;
  143.       crsrend:if basepos<>max then begin
  144.         prescr:=scrpos;
  145.         if max<winsize then scrpos:=max else scrpos:=winsize;
  146.         basepos:=max;
  147.         dumpscreen(max-scrpos);
  148.       end;
  149.       crsrpgup:if scrpos>1 then begin
  150.         prescr:=scrpos;
  151.         if basepos-scrpos>0 then dec(basepos,scrpos-1) else basepos:=1;
  152.         scrpos:=1;
  153.       end
  154.       else if basepos>1 then begin
  155.         prescr:=scrpos;
  156.         if basepos>winsize then dec(basepos,winsize) else basepos:=1;
  157.         dumpscreen(basepos-scrpos);
  158.       end;
  159.       crsrpgdn:if scrpos<winsize then begin
  160.         if basepos<>max then begin
  161.           prescr:=scrpos;
  162.           if max<winsize then begin scrpos:=max; basepos:=max; end
  163.           else begin inc(basepos,winsize-scrpos); scrpos:=winsize; end;
  164.         end;
  165.       end
  166.       else if basepos<max then begin
  167.         if basepos<(max-winsize) then inc(basepos,winsize) else basepos:=max;
  168.         dumpscreen(basepos-winsize);
  169.       end;
  170.       ord('m'),ord('M'):setmode;
  171.       crsrcr:begin esc:=true; select:=basepos; end;
  172.       crsresc:begin esc:=true; select:=0; end;
  173.     end;
  174.   until esc;
  175.   getscr;
  176. end;
  177.  
  178. procedure sort(l,r:integer);
  179. var i,j:integer; x,y:pathstr;
  180. begin
  181.   i:=l; j:=r; x:=copy(list^[(l+r) div 2],10,3)+copy(list^[(l+r) div 2],1,8);
  182.   repeat
  183.     while (copy(list^[i],10,3)+copy(list^[i],1,8))<x do inc(i);
  184.     while x<(copy(list^[j],10,3)+copy(list^[j],1,8)) do dec(j);
  185.     if i<=j then begin
  186.       y:=list^[i]; list^[i]:=list^[j]; list^[j]:=y;
  187.       inc(i); dec(j);
  188.     end;
  189.   until i>j;
  190.   if l<j then sort(l,j);
  191.   if i<r then sort(i,r);
  192. end;
  193.  
  194. function fileexist(s:pathstr):boolean; var di:searchrec; begin
  195.   findfirst(s,anyfile,di); fileexist:=(doserror=0); end;
  196.  
  197. procedure setdrive(drive:byte); assembler; asm { 0=A: }
  198.   mov dl,drive; mov ah,0eh; int 21h; end;
  199.  
  200. function getdrive:byte; assembler; asm { 0=A: }
  201.   mov ah,19h; int 21h; end;
  202.  
  203. function flopdrives:byte; assembler; { 0=none, 1=A:, 2=A: & B: }
  204. asm
  205.   int 11h
  206.   test al,1
  207.   jz @nodrives
  208.   ror al,2
  209.   and al,3
  210.   inc ax
  211.   jmp @out
  212.  @nodrives:
  213.   xor al,al
  214.  @out:
  215. end;
  216.  
  217. function selectfile(path:pathstr):pathstr;
  218. const
  219.   cdirstr:pathstr='<DIR>';
  220.   months:array[1..12] of str3=('jan','feb','mar','apr','may','jun',
  221.                                'jul','aug','sep','oct','nov','dec');
  222. var
  223.   gifinfo:gif_inforec;
  224.   pcxinfo:pcx_inforec;
  225.   celinfo:cel_inforec;
  226.   rixinfo:rix_inforec;
  227.   bmpinfo:bmp_inforec;
  228.   lbminfo:lbm_inforec;
  229.   di:searchrec;
  230.   fname:namestr; fext:extstr; fdir:dirstr;
  231.   dt:datetime;
  232.   tmp:str20;
  233.   i:word;
  234.   dummy,last,j,dr:byte;
  235.   c:char;
  236. begin
  237.   setscr;
  238.   if globalpath<>prevpath then begin
  239.     prevpath:=globalpath;
  240.     if list<>nil then freemem(list,listsize);
  241.     files:=0;
  242.     findfirst('*.*',anyfile,di);
  243.     while doserror=0 do begin inc(files); findnext(di); end;   { count files }
  244.     inc(files,drives);       { add number of drives to number of total files }
  245.     listsize:=files*sizeof(item);
  246.     getmem(list,listsize);
  247.     i:=0;                                   { read files in select-structure }
  248.     dr:=flopdrives;                                          { floppy-drives }
  249.     last:=getdrive;                                     { save current drive }
  250.     if dr>0 then
  251.       for j:=1 to flopdrives do begin
  252.         fillchar(list^[i],sizeof(item),0);
  253.         list^[i][0]:=chr(itemsize);
  254.         tmp:=#17'['+chr(ord('A')+pred(j))+':]';
  255.         move(tmp[1],list^[i][1],length(tmp));
  256.         inc(i);
  257.       end;
  258.     for dr:=2 to 25 do begin                                  { other drives }
  259.       setdrive(dr);
  260.       if getdrive=dr then begin
  261.         fillchar(list^[i],sizeof(item),0);
  262.         list^[i][0]:=chr(itemsize);
  263.         tmp:=#17'['+chr(ord('A')+dr)+':]';
  264.         move(tmp[1],list^[i][1],length(tmp));
  265.         inc(i);
  266.       end;
  267.     end;
  268.     setdrive(last);                                     { restore last drive }
  269.     findfirst('*.*',anyfile,di);
  270.     while doserror=0 do begin
  271.       with di do begin
  272.         fillchar(list^[i],sizeof(item),0);
  273.         list^[i][0]:=chr(itemsize);
  274.         if bitson(attr,directory) then begin                   { directories }
  275.           if name<>'.' then begin
  276.             if name<>'..' then name:=#25+name else name:=#24+name;
  277.             move(name[1],list^[i][1],length(name));
  278.             move(cdirstr[1],list^[i][15],7);
  279.             unpacktime(time,dt);
  280.             with dt do tmp:=lz(day,2)+'-'+months[month]+'-'+lz(year-1900,2);
  281.             move(tmp[1],list^[i][24],length(tmp));
  282.             with dt do tmp:=lz(hour,2)+':'+lz(min,2)+':'+lz(sec,2);
  283.             move(tmp[1],list^[i][35],length(tmp));
  284.             inc(i);
  285.           end;
  286.         end
  287.         else {if bitson(attr,archive) then} begin                    { files }
  288.           fsplit(name,fdir,fname,fext);
  289.           tmp:=copy(fext,2,length(fext)-1);
  290.           tmp:=strdn(tmp);
  291.           if (tmp='gif') or (tmp='pcx') or (tmp='lbm') or
  292.              (tmp='bmp') or (copy(tmp,1,2)='sc') or (tmp='cel') then begin
  293.             if tmp='gif' then begin
  294.               dummy:=gif_info(fname+fext,gifinfo);
  295.               with gifinfo do tmp:=lz(xres,0)+'x'+lz(yres,0)+'x'+lz(1 shl pixs,0);
  296.             end
  297.             else if tmp='pcx' then begin
  298.               dummy:=pcx_info(fname+fext,pcxinfo);
  299.               with pcxinfo do tmp:=lz(xres,0)+'x'+lz(yres,0)+'x'+lz(1 shl pixs,0);
  300.             end
  301.             else if tmp='lbm' then begin
  302.               dummy:=lbm_info(fname+fext,lbminfo);
  303.               with lbminfo do tmp:=lz(xres,0)+'x'+lz(yres,0)+'x'+lz(1 shl pixs,0);
  304.             end
  305.             else if tmp='bmp' then begin
  306.               dummy:=bmp_info(fname+fext,bmpinfo);
  307.               with bmpinfo do begin
  308.                 if (xres=0) or (yres=0) or (pixs=0) then tmp:='invalid'
  309.                 else tmp:=lz(xres,0)+'x'+lz(yres,0)+'x'+lz(1 shl pixs,0);
  310.               end;
  311.             end
  312.             else if copy(tmp,1,2)='sc' then begin
  313.               dummy:=rix_info(fname+fext,rixinfo);
  314.               with rixinfo do tmp:=lz(xres,0)+'x'+lz(yres,0)+'x'+lz(1 shl pixs,0);
  315.             end
  316.             else if tmp='cel' then begin
  317.               dummy:=cel_info(fname+fext,celinfo);
  318.               with celinfo do tmp:=lz(xres,0)+'x'+lz(yres,0)+'x'+lz(1 shl pixs,0);
  319.             end;
  320.             move(tmp[1],list^[i][45],length(tmp));
  321.             if length(fname)>0 then move(fname[1],list^[i][1],length(fname));
  322.             if length(fext)>0 then move(fext[2],list^[i][10],length(fext)-1);
  323.             str(size:7,tmp); move(tmp[1],list^[i][15],7);
  324.             unpacktime(time,dt);
  325.             with dt do tmp:=lz(day,2)+'-'+months[month]+'-'+lz(year-(year div 100)*100,2);
  326.             move(tmp[1],list^[i][24],length(tmp));
  327.             with dt do tmp:=lz(hour,2)+':'+lz(min,2)+':'+lz(sec,2);
  328.             move(tmp[1],list^[i][35],length(tmp));
  329.             inc(i);
  330.           end;
  331.         end;
  332.       end;
  333.       findnext(di);
  334.     end;
  335.     scrsize:=v_lines-6;
  336.     if i<scrsize then scrsize:=i;
  337.     sort(0,i-1);                                       { sort directory list }
  338.     files:=i;
  339.   end;
  340.   cursoroff;                                         { select file from list }
  341.   curnum:=select(3,3,4+itemsize,4+scrsize,path,' Select a File ',curnum,files,list);
  342.   i:=curnum;
  343.   if i<>0 then begin
  344.     if list^[i-1][10]<>#0 then selectfile:=copy(list^[i-1],1,pos(#0,list^[i-1])-1)+'.'+copy(list^[i-1],10,3)
  345.     else selectfile:=copy(list^[i-1],1,pos(#0,list^[i-1])-1);
  346.   end else selectfile:='';
  347.   getscr; cursoron;
  348. end;
  349.  
  350. function getfname:pathstr;
  351. var
  352.   curdir,fname,drive:pathstr;
  353.   is_drive,is_dir,is_file:boolean;
  354. begin
  355.   getdir(0,curdir);
  356.   repeat
  357.     fname:=selectfile(curdir);         { select dir, drive or file from list }
  358.     is_drive:=false; is_dir:=false; is_file:=false;
  359.     if fname<>'' then begin                                  { find out type }
  360.       if (fname[1] in [#24,#25]) then is_dir:=true
  361.       else if fname[1]=#17 then is_drive:=true
  362.       else is_file:=true;
  363.     end else is_file:=true;
  364.     if is_drive then begin                { select drive and curdir on drive }
  365.       drive:=copy(fname,3,2);
  366.       chdir(drive);
  367.       getdir(0,curdir);
  368.       globalpath:=noslash(curdir);
  369.       curnum:=1;
  370.     end
  371.     else if is_dir then begin                            { select new curdir }
  372.       if fname[1]=#25 then begin
  373.         if length(curdir)>3 then curdir:=curdir+'\'+copy(fname,2,length(fname)-1)
  374.         else curdir:=curdir+copy(fname,2,length(fname)-1);
  375.       end
  376.       else begin
  377.         curdir:=copy(curdir,1,rpos(['\'],curdir)-1);
  378.         if length(curdir)=2 then curdir:=curdir+'\';
  379.       end;
  380.       chdir(curdir);
  381.       globalpath:=noslash(curdir);
  382.       curnum:=1;
  383.     end;
  384.   until is_file;
  385.   if fname<>'' then getfname:=fexpand(fname) else getfname:='';
  386. end;
  387.  
  388. {----------------------------------------------------------------------------}
  389.  
  390. var
  391.   bgipath,pathname,olddir:pathstr;
  392.   fname:namestr;
  393.   fext:extstr;
  394.   fdir:dirstr;
  395.   tmp:string;
  396.   dummy,x,y:byte;
  397. begin
  398.   bgipath:='i:\gfxfx2';                                 { path to bgi-driver }
  399.   curnum:=1;
  400.   list:=nil;
  401.   drives:=0;                                     { retrieve number of drives }
  402.   y:=getdrive; { save drive }
  403.   for x:=2 to 25 do begin
  404.     setdrive(x);
  405.     if getdrive=x then inc(drives);
  406.   end;
  407.   setdrive(y); { restore drive }
  408.   inc(drives,flopdrives);
  409.   getdir(0,olddir);                                            { save curdir }
  410.   globalpath:=olddir; prevpath:='';
  411.   x:=getx; y:=gety;
  412.   repeat
  413.     pathname:=getfname;
  414.     if pathname<>'' then begin
  415.       setscr;
  416.       fsplit(pathname,fdir,fname,fext);
  417.       tmp:=copy(fext,2,length(fext)-1);
  418.       fext:=strdn(tmp);
  419.       if fext='gif' then dummy:=gif_display(pathname,bgipath,mode)
  420.       else if fext='pcx' then dummy:=pcx_display(pathname,bgipath,mode)
  421.       else if fext='lbm' then dummy:=lbm_display(pathname,bgipath,mode)
  422.       else if fext='bmp' then dummy:=bmp_display(pathname,bgipath,mode)
  423.       else if fext='cel' then dummy:=cel_display(pathname,bgipath,mode)
  424.       else if copy(fext,1,2)='sc' then dummy:=rix_display(pathname,bgipath,mode);
  425.       clearkeybuf;
  426.       waitkey(0);
  427.       setvideo(u_lm);
  428.       getscr;
  429.     end;
  430.   until pathname='';
  431.   chdir(olddir);                                        { restore old curdir }
  432.   placecursor(x,y);
  433. end.
  434.